home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / epp / pmodules / mdarray.e < prev    next >
Text File  |  1980-01-05  |  5KB  |  156 lines
  1. /*========================================================================*/
  2. /*                                                                        */
  3. /* Multi-Dimensional arrays in E.                                          */
  4. /*                                                                        */
  5. /*========================================================================*/
  6.  
  7.  
  8. PMODULE 'PMODULES:listItem'
  9.  
  10.  
  11. RAISE "MEM" IF New () = NIL,
  12.       "MEM" IF List () = NIL
  13.  
  14.  
  15. CONST SIZEOF_CHAR = 1,
  16.       SIZEOF_INT  = 2,
  17.       SIZEOF_LONG = 4
  18.  
  19.  
  20. OBJECT md_arrayType
  21.   uBound             : LONG
  22.   elementSize        : LONG
  23.   numberOfDimensions : LONG
  24.   sizeOfDimension    : LONG
  25.   elements           : LONG
  26. ENDOBJECT
  27.  
  28.  
  29. /*-- Set this to the value of the exception to be    --*/
  30. /*-- raised if any of the array bounds checks fails. --*/
  31. /*-- Default of -1 means raise no exception.         --*/
  32. DEF md_constraintError = -1
  33.  
  34.  
  35. PROC md_handleConstraintError ()
  36.   IF md_constraintError <> -1 THEN Raise (md_constraintError)
  37. ENDPROC
  38.  
  39.  
  40. PROC md_dim (array     : PTR TO md_arrayType,
  41.              indexList : PTR TO LONG,
  42.              elementSize)       /*-- Use one of the provided constants. --*/
  43.   DEF numberOfElements = 1,
  44.       sizeOfDimension = NIL : PTR TO LONG,
  45.       i, j
  46.  
  47.   /*-- Compute number of elements and create array. --*/
  48.   array.elementSize := elementSize
  49.   array.numberOfDimensions := ListLen (indexList)
  50.   FOR i := 0 TO (array.numberOfDimensions - 1) DO numberOfElements := Mul (numberOfElements, indexList [i])
  51.   array.elements := New (Mul (numberOfElements, elementSize))
  52.  
  53.   /*-- Store upper bounds of each dimension. --*/
  54.   array.uBound := List (array.numberOfDimensions)
  55.   ListCopy (array.uBound, indexList, ALL)
  56.   MapList ({i}, array.uBound, array.uBound, `i - 1)
  57.  
  58.   /*-- Compute and store size of each dimension for later index computations. --*/
  59.  
  60.   /*-- Init list. --*/
  61.   array.sizeOfDimension := List (array.numberOfDimensions)
  62.   SetList (array.sizeOfDimension, array.numberOfDimensions)
  63.   MapList ({i}, array.sizeOfDimension, array.sizeOfDimension, `1)
  64.  
  65.   /*-- Compute size of each dimension. --*/
  66.   sizeOfDimension := array.sizeOfDimension
  67.   FOR i := 0 TO (array.numberOfDimensions - 1)
  68.     FOR j := (i + 1) TO (array.numberOfDimensions - 1)
  69.       sizeOfDimension [i] := Mul (sizeOfDimension [i], indexList [j])
  70.     ENDFOR
  71.   ENDFOR
  72. ENDPROC
  73.   /* md_dim */
  74.  
  75.  
  76. PROC md_withinBounds (array     : PTR TO md_arrayType,
  77.                       indexList : PTR TO LONG)
  78.   DEF i
  79.   FOR i := 0 TO (array.numberOfDimensions - 1) DO IF (indexList [i] < 0) OR
  80.                                                      (indexList [i] > listItem (array.uBound, i)) THEN RETURN FALSE
  81. ENDPROC  TRUE
  82.   /* md_withinBounds */
  83.  
  84.  
  85. PROC md_offset (array     : PTR TO md_arrayType,
  86.                 indexList : PTR TO LONG)
  87.   DEF offset = 0, i
  88.   FOR i := 0 TO (array.numberOfDimensions - 1)
  89.     offset := offset + Mul (indexList [i],
  90.                             listItem (array.sizeOfDimension, i))
  91.   ENDFOR
  92. ENDPROC  Mul (offset, array.elementSize)
  93.   /* md_offset */
  94.  
  95.  
  96. PROC md_set (array     : PTR TO md_arrayType,
  97.              indexList : PTR TO LONG,
  98.              value)
  99.   DEF charPtr : PTR TO CHAR,
  100.       intPtr  : PTR TO INT,
  101.       longPtr : PTR TO LONG,
  102.       elementSize
  103.   IF md_withinBounds (array, indexList)
  104.     elementSize := array.elementSize
  105.     SELECT elementSize
  106.       CASE SIZEOF_CHAR
  107.         charPtr := array.elements + md_offset (array, indexList)
  108.         charPtr [] := value
  109.       CASE SIZEOF_INT
  110.         intPtr := array.elements + md_offset (array, indexList)
  111.         intPtr [] := value
  112.       CASE SIZEOF_LONG
  113.         longPtr := array.elements + md_offset (array, indexList)
  114.         longPtr [] := value
  115.     ENDSELECT
  116.   ELSE
  117.     md_handleConstraintError ()
  118.   ENDIF
  119. ENDPROC
  120.   /* md_set */
  121.  
  122.  
  123. PROC md_get (array     : PTR TO md_arrayType,
  124.              indexList : PTR TO LONG)
  125.   DEF charPtr : PTR TO CHAR,
  126.       intPtr  : PTR TO INT,
  127.       longPtr : PTR TO LONG,
  128.       elementSize
  129.   IF md_withinBounds (array, indexList)
  130.     elementSize := array.elementSize
  131.     SELECT elementSize
  132.       CASE SIZEOF_CHAR
  133.         charPtr := array.elements + md_offset (array, indexList)
  134.         RETURN charPtr []
  135.       CASE SIZEOF_INT
  136.         intPtr := array.elements + md_offset (array, indexList)
  137.         RETURN intPtr []
  138.       CASE SIZEOF_LONG
  139.         longPtr := array.elements + md_offset (array, indexList)
  140.         RETURN longPtr []
  141.     ENDSELECT
  142.   ELSE
  143.     md_handleConstraintError ()
  144.   ENDIF
  145. ENDPROC
  146.   /* md_get */
  147.  
  148.  
  149. PROC md_dispose (array : PTR TO md_arrayType)
  150.   Dispose (array.uBound)
  151.   Dispose (array.elements)
  152. ENDPROC
  153.   /* md_dispose */
  154.  
  155.  
  156.